home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / mh-e / mh-pick.el < prev    next >
Encoding:
Text File  |  1995-06-06  |  6.5 KB  |  195 lines
  1. ;;; mh-pick --- make a search pattern and search for a message in mh-e
  2. ;; Time-stamp: <95/05/29 16:24:07 gildea>
  3.  
  4. ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
  5.  
  6. ;; This file is part of GNU Emacs.
  7.  
  8. ;; GNU Emacs is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;;; Commentary:
  23.  
  24. ;; Internal support for mh-e package.
  25.  
  26. ;;; Change Log:
  27.  
  28. ;; $Id: mh-pick.el,v 1.5 95/05/29 20:32:50 gildea Exp $
  29.  
  30. ;;; Code:
  31.  
  32. (provide 'mh-pick)
  33. (require 'mh-e)
  34.  
  35. (defvar mh-pick-mode-hook nil
  36.   "Invoked in `mh-pick-mode' on a new pattern.")
  37.  
  38. ;;; Internal variables:
  39.  
  40. (defvar mh-pick-mode-map (make-sparse-keymap)
  41.   "Keymap for searching folder.")
  42.  
  43. (defvar mh-searching-folder nil)    ;Folder this pick is searching.
  44.  
  45. (defun mh-search-folder (folder)
  46.   "Search FOLDER for messages matching a pattern.
  47. Add the messages found to the sequence named `search'."
  48.   (interactive (list (mh-prompt-for-folder "Search"
  49.                        mh-current-folder
  50.                        t)))
  51.   (switch-to-buffer-other-window "pick-pattern")
  52.   (if (or (zerop (buffer-size))
  53.       (not (y-or-n-p "Reuse pattern? ")))
  54.       (mh-make-pick-template)
  55.     (message ""))
  56.   (setq mh-searching-folder folder))
  57.  
  58. (defun mh-make-pick-template ()
  59.   ;; Initialize the current buffer with a template for a pick pattern.
  60.   (erase-buffer)
  61.   (insert "From: \n"
  62.       "To: \n"
  63.       "Cc: \n"
  64.       "Date: \n"
  65.       "Subject: \n"
  66.       "---------\n")
  67.   (mh-pick-mode)
  68.   (goto-char (point-min))
  69.   (end-of-line))
  70.  
  71. (put 'mh-pick-mode 'mode-class 'special)
  72.  
  73. (defun mh-pick-mode ()
  74.   "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
  75. After each field name, enter the pattern to search for.  If a field's
  76. value does not matter for the search, leave it empty.  To search the
  77. entire message, supply the pattern in the \"body\" of the template.
  78. Each non-empty field must be matched for a message to be selected.
  79. To effect a logical \"or\", use \\[mh-search-folder] multiple times.
  80. When you have finished, type  \\[mh-do-pick-search]  to do the search.
  81. \\{mh-pick-mode-map}
  82. Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook
  83. if that value is non-nil."
  84.   (interactive)
  85.   (kill-all-local-variables)
  86.   (make-local-variable 'mh-searching-folder)
  87.   (use-local-map mh-pick-mode-map)
  88.   (setq major-mode 'mh-pick-mode)
  89.   (mh-set-mode-name "MH-Pick")
  90.   (run-hooks 'mh-pick-mode-hook))
  91.  
  92.  
  93. (defun mh-do-pick-search ()
  94.   "Find messages that match the qualifications in the current pattern buffer.
  95. Messages are searched for in the folder named in mh-searching-folder.
  96. Add the messages found to the sequence named `search'."
  97.   (interactive)
  98.   (let ((pattern-buffer (buffer-name))
  99.     (searching-buffer mh-searching-folder)
  100.     range
  101.     msgs
  102.     (finding-messages t)
  103.     (pattern nil)
  104.     (new-buffer nil))
  105.     (save-excursion
  106.       (cond ((get-buffer searching-buffer)
  107.          (set-buffer searching-buffer)
  108.          (setq range (list (format "%d-%d"
  109.                        mh-first-msg-num mh-last-msg-num))))
  110.         (t
  111.          (mh-make-folder searching-buffer)
  112.          (setq range '("all"))
  113.          (setq new-buffer t))))
  114.     (message "Searching...")
  115.     (goto-char (point-min))
  116.     (while (and range
  117.         (setq pattern (mh-next-pick-field pattern-buffer)))
  118.       (setq msgs (mh-seq-from-command searching-buffer
  119.                       'search
  120.                       (mh-list-to-string
  121.                        (list "pick" pattern searching-buffer
  122.                          "-list"
  123.                          (mh-coalesce-msg-list range)))))
  124.       (setq range msgs))        ;restrict the pick range for next pass
  125.     (message "Searching...done")
  126.     (if new-buffer
  127.     (mh-scan-folder searching-buffer msgs)
  128.     (switch-to-buffer searching-buffer))
  129.     (mh-add-msgs-to-seq msgs 'search)
  130.     (delete-other-windows)))
  131.  
  132.  
  133. (defun mh-seq-from-command (folder seq seq-command)
  134.   ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
  135.   ;; COMMAND is a list.  The first element is a program name
  136.   ;; and the subsequent elements are its arguments, all strings.
  137.   (let ((msg)
  138.     (msgs ())
  139.     (case-fold-search t))
  140.     (save-excursion
  141.       (save-window-excursion
  142.     (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command))
  143.         ;; "pick" outputs one number per line
  144.         (while (setq msg (car (mh-read-msg-list)))
  145.           (setq msgs (cons msg msgs))
  146.           (forward-line 1))))
  147.       (set-buffer folder)
  148.       (setq msgs (nreverse msgs))    ;put in ascending order
  149.       msgs)))
  150.  
  151.  
  152. (defun mh-next-pick-field (buffer)
  153.   ;; Return the next piece of a pick argument that can be extracted from the
  154.   ;; BUFFER.
  155.   ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat")
  156.   ;; or NIL if no pieces remain.
  157.   (set-buffer buffer)
  158.   (let ((case-fold-search t))
  159.     (cond ((eobp)
  160.        nil)
  161.       ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
  162.        (let* ((component
  163.            (format "--%s"
  164.                (downcase (buffer-substring (match-beginning 1)
  165.                                (match-end 1)))))
  166.           (pat (buffer-substring (match-beginning 2) (match-end 2))))
  167.            (forward-line 1)
  168.            (list component pat)))
  169.       ((re-search-forward "^-*$" nil t)
  170.        (forward-char 1)
  171.        (let ((body (buffer-substring (point) (point-max))))
  172.          (if (and (> (length body) 0) (not (equal body "\n")))
  173.          (list "-search" body)
  174.          nil)))
  175.       (t
  176.        nil))))
  177.  
  178. ;;; Build the pick-mode keymap:
  179.  
  180. (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
  181. (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
  182. (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
  183. (define-key mh-pick-mode-map "\C-c\C-f\C-d" 'mh-to-field)
  184. (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
  185. (define-key mh-pick-mode-map "\C-c\C-f\C-r" 'mh-to-field)
  186. (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
  187. (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
  188. (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
  189. (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
  190. (define-key mh-pick-mode-map "\C-c\C-fd" 'mh-to-field)
  191. (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
  192. (define-key mh-pick-mode-map "\C-c\C-fr" 'mh-to-field)
  193. (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
  194. (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
  195.